Lab 11

#install.packages("plotly")
library(plotly)
## Loading required package: ggplot2
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(ggplot2)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(stringr)
library(tidyr)
colleges <- read.csv("https://remiller1450.github.io/data/Colleges2019.csv")

Question 1

plot_ly(colleges) %>%
  add_trace(x = ~Private, y = ~Enrollment, type = "violin")

Question 2

plot_ly(data = colleges, hoverinfo = "text") %>%
  add_trace(type = "scatter", mode = "markers", x = ~FourYearComp_Males, y = ~FourYearComp_Females, color = ~Private, text = ~str_c("<b>", Name, "<b>", "<br>", "Percentage Female: ", 100 *round(PercentFemale, digits = 2)))
## Warning: Ignoring 121 observations
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
00.20.40.60.8100.20.40.60.81
PrivatePublicFourYearComp_MalesFourYearComp_Females

Question 3

model <- lm(Debt_median ~ Net_Tuition + ACT_median, data = colleges)

x1 <- seq(min(colleges$Net_Tuition, na.rm = TRUE), 
          max(colleges$Net_Tuition, na.rm = TRUE), 
          length.out = 100)
x2 <- seq(min(colleges$ACT_median, na.rm = TRUE), 
          max(colleges$ACT_median, na.rm = TRUE), 
          length.out = 100)

grid <- expand.grid(Net_Tuition = x1, ACT_median = x2)

z <- predict(model, newdata = grid)

m <- matrix(z, nrow = 100, ncol = 100, byrow = TRUE)

plot_ly() %>%
  add_trace(data = colleges, type = "scatter3d", mode = "markers", x = ~Net_Tuition, y = ~ACT_median, 
            z = ~Debt_median, color = I("black"), 
            marker = list(size = 3)) %>% 
  add_surface(x = x1, y = x2, z = m, colorscale = "Red")
## Warning: Ignoring 484 observations

Question 4

shootings <- read.csv('https://remiller1450.github.io/data/MassShootings.csv')

shoot1 <- shootings %>%
  group_by(Year) %>%
  summarize(sum(Fatalities), sum(Injured)) %>%
  mutate(Fatalities = cumsum(`sum(Fatalities)`), Injured = cumsum(`sum(Injured)`))
  
shootlong <- pivot_longer(shoot1,
  cols = c("Fatalities", "Injured"),                    
  names_to = "Type",
  values_to = "Total"
)
        
plot_ly(shootlong, x = ~Type, y = ~Total, type = "bar",
        frame = ~Year) %>% 
  animation_opts(frame = 100, easing = "linear", redraw = FALSE)
FatalitiesInjured0200400600800100012001400
trace 0Year: 1982198219871990199319961999200320062009201220152018TypeTotalPlay

Lab 12

# install.packages("maps")
# install.packages("maptools")
library(ggplot2)
library(dplyr)
library(maps)
library(maptools)
## Loading required package: sp
## The legacy packages maptools, rgdal, and rgeos, underpinning the sp package,
## which was just loaded, were retired in October 2023.
## Please refer to R-spatial evolution reports for details, especially
## https://r-spatial.org/r/2023/05/15/evolution4.html.
## It may be desirable to make the sf package available;
## package maintainers should consider adding sf to Suggests:.
## Please note that 'maptools' will be retired during October 2023,
## plan transition at your earliest convenience (see
## https://r-spatial.org/r/2023/05/15/evolution4.html and earlier blogs
## for guidance);some functionality will be moved to 'sp'.
##  Checking rgeos availability: FALSE
theme_set(theme_bw())
states <- map_data("state")
counties <- map_data("county")
data("us.cities")
cities <- us.cities %>% filter(capital == 2) %>% filter(!(country.etc %in% c("AK", "HI")))

Question 1

ggplot(data = states, aes(x = long, y = lat)) + 
  geom_polygon(data = states, color = "black", fill = NA, linewidth = 0.3, alpha = 0.3, aes(group = group)) +
  geom_polygon(data = counties, color = "blue", fill = "white", linewidth = 0.1, alpha = 0.5, aes(group = group)) +
  geom_point(data = cities, aes(x = long, y = lat), size = 1.5, color = 'brown1')

Question 2

state_abr <- read.csv("https://collinn.github.io/data/state_abrv.csv")
data("midwest")
mid1 <- inner_join(x = midwest, y = state_abr, by = c("state" = "Abbreviation"))
mid2 <- mid1 %>%
  mutate(region = str_to_lower(State)) %>%
  mutate(subregion = str_to_lower(county))

midstates <- inner_join(x = states, y = mid2, by = c("region"))
## Warning in inner_join(x = states, y = mid2, by = c("region")): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 2940 of `x` matches multiple rows in `y`.
## ℹ Row 1 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.
midcounties <- inner_join(x = counties, y = mid2, by = c("region", "subregion"))

ggplot(data = midstates, aes(x = long, y = lat)) + 
  geom_polygon(data = midstates, color = "black", linewidth = 0.5, aes(group = group)) +
  geom_polygon(data = midcounties, color = "black", linewidth = 0.2, alpha = 0.75, aes(fill = percollege, group = group)) +
   scale_fill_continuous(type = "viridis", option = "H") +
  labs(fill = "Percent College")

Question 3

world <- readShapeSpatial("world_shape/ne_50m_admin_0_countries")
## Warning: shapelib support is provided by GDAL through the sf and terra packages
## among others
## Warning: shapelib support is provided by GDAL through the sf and terra
## paackages among others
## Warning: shapelib support is provided by GDAL through the sf and terra packages
## among others
worldpoly <- fortify(world)
## Regions defined for each Polygons
worlddat <- world@data
worlddat$id <-  as.character((1:nrow(worlddat)-1))
worldfull <- left_join(worldpoly, worlddat, by = "id")

worldfull1 <- worldfull %>%
  mutate(gdpmd = cut_number(GDP_MD, n = 4, labels = c("1st Quartile", "2nd Quartile", "3rd Quartile", "4th Quartile")))

ggplot(data = worldfull1, aes(long, lat, group = group)) +
  geom_polygon(aes(fill = gdpmd), 
               color = "black") + 
  scale_fill_brewer(palette = "YlGnBu")